home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 May / EnigmA AMIGA RUN 27 (1998)(G.R. Edizioni)(IT)[!][issue 1998-05].iso / earcd / sinclair-ql / palette_bas < prev    next >
Text File  |  1998-02-11  |  4KB  |  133 lines
  1. 100 REMark PALETTE Editor for Amiga Qdos 3.22 (AGA)
  2. 110 REMark v1.6, Simon N Goodwin, July 1994
  3. 120 REMark N.B. MODE changes reset the default palette
  4. 130 :
  5. 140 REMark IMPLICIT% t,p,c:REM For Turbo speed
  6. 150 REMark DATA_AREA 1:REM Minimal dataspace needed
  7. 160 :
  8. 170 MODE 4
  9. 180 PALETTE_ED
  10. 190 STOP
  11. 200 DEFine PROCedure PALETTE_ED
  12. 210  LET custom="14675968":REMark OCS/ECS Chip Set base = $DFF000
  13. 220  LET palbase=custom+256+128:REMark Offset to palette word 0
  14. 230  OPEN #3,"scr_512x256a0x0"
  15. 240  PTR_LIMITS 0,0,255,95
  16. 250  PTR_INC 64,32
  17. 260  PTR_POS 0,0
  18. 270  PTR_ON
  19. 280  SCR_PRIORITY 8,1
  20. 290  SETUP
  21. 300  INTERACT
  22. 310  SCR_PRIORITY 4,1
  23. 320  PTR_OFF
  24. 330  PTR_LIMITS 0,0,255,255
  25. 340  PTR_INC 4,8
  26. 350  CLOSE#3
  27. 360 END DEFine PALETTE_ED
  28. 370 :
  29. 380 DEFine PROCedure SETUP
  30. 382  IF PEEK(custom+125)=248 THEN 
  31. 384   REMark AGA, select low palette bits
  32. 386   POKE_W custom+262,0
  33. 388  END IF 
  34. 390  INK #3,7:PAPER#3,0:CLS#3
  35. 400  BLOCK#3;120,16,0,88,0
  36. 410  BLOCK#3;120,16,128,88,2
  37. 420  BLOCK#3;120,16,256,88,4
  38. 430  BLOCK#3;120,16,384,88,7
  39. 440  CURSOR #3,0,104
  40. 450  CSIZE #3,3,0
  41. 460  PRINT #3," INK 0    INK 2  INK 4   INK 7 "
  42. 470  CSIZE#3;0,1
  43. 480  CURSOR #3,506,6
  44. 490  PRINT #3,"R"
  45. 500  CURSOR #3,506,38
  46. 510  PRINT #3,"G"
  47. 520  CURSOR #3,506,70
  48. 530  PRINT #3,"B"
  49. 540  DIM c%(3,2):REMark Colour 0-3; R, G, B values 0-15
  50. 550  LET red%=0: green%=1: blue%=2:REMark Index 2 for C%
  51. 560  CSIZE #3,2,0
  52. 570  INK #3,2
  53. 580  RESTORE 900
  54. 590  FOR c=0 TO 3
  55. 600   FOR p=red%,green%,blue%
  56. 610    READ c%(c,p)
  57. 620    SLIDEBAR 3,c*128,p*32,INT(100*c%(c,p)/15)
  58. 630   END FOR p
  59. 640   UPDATE
  60. 650  END FOR c
  61. 660  CSIZE #3,2,1
  62. 670  CURSOR #3,0,130
  63. 680  PRINT #3;" ";
  64. 690  PAPER #3,7
  65. 700  STRIPEY #3;"Qdos PALETTE EDITOR v 1.6  "
  66. 710  CSIZE #3,0,1
  67. 720  STRIPEY #3;" 1994 Simon N Goodwin  "
  68. 730  CSIZE #3,2,0
  69. 740  PAPER #3,0
  70. 750  INK #3,4
  71. 760  CURSOR #3,0,160
  72. 770  PRINT #3,"Use arrow keys to select RED, GREEN or"\"BLUE component of any QL colour."
  73. 780  INK #3,2
  74. 790  PRINT #3,\"Press ENTER to increase component, SPACE"\"to decrease it, or ESC to end."
  75. 800 END DEFine SETUP
  76. 810 :
  77. 820 DEFine PROCedure UPDATE
  78. 830 LOCal t%
  79. 840 t%=c%(c,blue%)+c%(c,red%)*256+c%(c,green%)*16
  80. 850 POKE_W palbase+c*2,t%
  81. 860 CURSOR #3,32+c*128,114:PRINT #3,t%;"   ";
  82. 870 END DEFine UPDATE
  83. 880 :
  84. 890 REMark Initial MODE 4 palette values (R,G,B)
  85. 900 DATA 0,0,0,  15,0,0
  86. 910 DATA 0,15,0, 15,15,15
  87. 920 :
  88. 930 DEFine PROCedure INTERACT
  89. 940  LET p=red% : c=0 :REMark Start somewhere!
  90. 950  SLCTBAR 3,c*128,p*32
  91. 960  REPeat setbox
  92. 970   k%=KEYROW(1)
  93. 980   IF k% && 8 : EXIT setbox
  94. 990   IF (k% && 1) : c%(c,p)=c%(c,p)+(c%(c,p)<15):SLIDEBAR 3,c*128,p*32,INT(100*c%(c,p)/15):REMark ENTER = Increase
  95. 1000   IF (k% && 64): c%(c,p)=c%(c,p)-(c%(c,p)>0):SLIDEBAR 3,c*128,p*32,INT(100*c%(c,p)/15):REMark SPACE = Decrease
  96. 1010   IF k% && 2:DESLCTBAR 3,c*128,p*32:c=c-(c>0):SLCTBAR 3,c*128,p*32
  97. 1020   IF k% && 4:DESLCTBAR 3,c*128,p*32:p=p-(p>0):SLCTBAR 3,c*128,p*32
  98. 1030   IF k% && 16:DESLCTBAR 3,c*128,p*32:c=c+(c<3):SLCTBAR 3,c*128,p*32
  99. 1040   IF k% && 128:DESLCTBAR 3,c*128,p*32:p=p+(p<2):SLCTBAR 3,c*128,p*32
  100. 1050   UPDATE
  101. 1060  END REPeat setbox
  102. 1070 END DEFine INTERACT
  103. 1080 :
  104. 1090 DEFine PROCedure STRIPEY(Ch%,text$)
  105. 1100  LOCal t,col%
  106. 1110  col%=2
  107. 1120  FOR t=1 TO LEN(text$)
  108. 1130   INK #Ch%,col%
  109. 1140   col%=2-col%
  110. 1150   PRINT #Ch%,text$(t);
  111. 1160  END FOR t
  112. 1170 END DEFine STRIPEY
  113. 1180 :
  114. 1190 DEFine PROCedure SLIDEBAR(Ch%,x%,y%,p%)
  115. 1200  BLOCK#Ch%;112,1,x%+4,y%+2,7:BLOCK#Ch%;112,1,x%+4,y%+21,7:BLOCK#Ch%;2,20,x%+4,y%+2,7:BLOCK#Ch%;2,20,x%+114,y%+2,7
  116. 1210  BLOCK#Ch%;108,18,x%+6,y%+3,0
  117. 1220  BLOCK#Ch%;4,16,x%+p%+8,y%+4,7
  118. 1230 END DEFine SLIDEBAR
  119. 1240 :
  120. 1250 DEFine PROCedure SLCTBAR(Ch%,x%,y%)
  121. 1260  BLOCK#Ch%;120,2,x%,y%,0:BLOCK#Ch%;120,2,x%,y%+22,0:BLOCK#Ch%;4,24,x%,y%,0:BLOCK#Ch%;4,24,x%+116,y%,0
  122. 1270  BLOCK#Ch%;120,1,x%,y%,7:BLOCK#Ch%;120,1,x%,y%+23,7:BLOCK#Ch%;2,24,x%,y%,7:BLOCK#Ch%;2,24,x%+118,y%,7
  123. 1280 END DEFine SLCTBAR
  124. 1290 :
  125. 1300 DEFine PROCedure DESLCTBAR(Ch%,x%,y%)
  126. 1310  BLOCK#Ch%;120,2,x%,y%,0:BLOCK#Ch%;120,2,x%,y%+22,0:BLOCK#Ch%;4,24,x%,y%,0:BLOCK#Ch%;4,24,x%+116,y%,0
  127. 1320 END DEFine DESLCTBAR
  128. 1330 :
  129. 1340 DEFine PROCedure s
  130. 1350  DELETE flp1_PALETTE_bas
  131. 1360  SAVE flp1_PALETTE_bas
  132. 1370 END DEFine s
  133.